#' Save a **gt** table as a file
#'
#' @description
#' The `gtsave()` function makes it easy to save a **gt** table to a file. The
#' function guesses the file type by the extension provided in the output
#' filename, producing either an HTML, PDF, PNG, LaTeX, or RTF file.
#'
#' @details
#' Output filenames with either the `.html` or `.htm` extensions will produce an
#' HTML document. In this case, we can pass a `TRUE` or `FALSE` value to the
#' `inline_css` option to obtain an HTML document with inlined CSS styles (the
#' default is `FALSE`). More details on CSS inlining are available at
#' [as_raw_html()]. We can pass values to arguments in [htmltools::save_html()]
#' through the `...`. Those arguments are either `background` or `libdir`,
#' please refer to the **htmltools** documentation for more details on the use
#' of these arguments.
#'
#' If the output filename is expressed with the `.rtf` extension then an RTF
#' file will be generated. In this case, there is an option that can be passed
#' through `...`: `page_numbering`. This controls RTF document page numbering
#' and, by default, page numbering is not enabled (i.e., `page_numbering =
#' "none"`).
#'
#' We can create an image file based on the HTML version of the `gt` table. With
#' the filename extension `.png`, we get a PNG image file. A PDF document can be
#' generated by using the `.pdf` extension. This process is facilitated by the
#' **webshot** package, so, this package needs to be installed before
#' attempting to save any table as an image file. There is the option of passing
#' values to the underlying [webshot::webshot()] function though `...`. Some of
#' the more useful arguments for PNG saving are `zoom` (defaults to a scale
#' level of `2`) and `expand` (adds whitespace pixels around the cropped table
#' image, and has a default value of `5`). There are several more options
#' available so have a look at the **webshot** documentation for further
#' details.
#'
#' If the output filename extension is either of `.tex`, `.ltx`, or `.rnw`, a
#' LaTeX document is produced. An output filename of `.rtf` will generate an RTF
#' document. The LaTeX and RTF saving functions don't have any options to pass
#' to `...`.
#'
#' @param data A table object that is created using the [gt()] function.
#' @param filename The file name to create on disk. Ensure that an extension
#'   compatible with the output types is provided (`.html`, `.tex`, `.ltx`,
#'   `.rtf`). If a custom save function is provided then the file extension is
#'   disregarded.
#' @param path An optional path to which the file should be saved (combined with
#'   filename).
#' @param ... All other options passed to the appropriate internal saving
#'   function.
#'
#' @examples
#' if (interactive()) {
#'
#' # Use `gtcars` to create a gt table; add
#' # a stubhead label to describe what is
#' # in the stub
#' tab_1 <-
#'   gtcars %>%
#'   dplyr::select(model, year, hp, trq) %>%
#'   dplyr::slice(1:5) %>%
#'   gt(rowname_col = "model") %>%
#'   tab_stubhead(label = "car")
#'
#' # Get an HTML file with inlined CSS
#' # (which is necessary for including the
#' # table as part of an HTML email)
#' tab_1 %>%
#'   gtsave(
#'     "tab_1.html", inline_css = TRUE,
#'     path = tempdir()
#'   )
#'
#' # By leaving out the `inline_css` option,
#' # we get a more conventional HTML file
#' # with embedded CSS styles
#' tab_1 %>%
#'   gtsave("tab_1.html", path = tempdir())
#'
#' # Saving as PNG file results in a cropped
#' # image of an HTML table; the amount of
#' # whitespace can be set
#' tab_1 %>%
#'   gtsave(
#'     "tab_1.png", expand = 10,
#'     path = tempdir()
#'   )
#'
#' # Any use of the `.tex`, `.ltx`, or `.rnw`
#' # will result in the output of a LaTeX
#' # document
#' tab_1 %>%
#'   gtsave("tab_1.tex", path = tempdir())
#' }
#'
#' @family Export Functions
#' @section Function ID:
#' 13-1
#'
#' @export
gtsave <- function(data,
                   filename,
                   path = NULL,
                   ...) {

  # Perform input object validation
  stop_if_not_gt(data = data)

  # Get the lowercased file extension
  file_ext <- gtsave_file_ext(filename)

  ext_supported_text <-
    paste0(
      "We can use:\n",
      " * `.html`, `.htm` (HTML file)\n",
      " * `.png`          (PNG file)\n",
      " * `.pdf`          (PDF file)\n",
      " * `.tex`, `.rnw`  (LaTeX file)\n",
      " * `.rtf`          (RTF file)\n"
    )

  # Stop function if a file extension is not provided
  if (file_ext == "") {

    stop("A file extension is required in the provided filename. ",
         ext_supported_text,
         call. = FALSE)
  }

  # Use the appropriate save function based
  # on the filename extension
  switch(
    file_ext,
    "htm" = ,
    "html" = gt_save_html(data = data, filename, path, ...),
    "ltx" = , # We don't verbally support using `ltx`
    "rnw" = ,
    "tex" = gt_save_latex(data = data, filename, path, ...),
    "rtf" = gt_save_rtf(data = data, filename, path, ...),
    "png" = ,
    "pdf" = gt_save_webshot(data = data, filename, path, ...),
    {
      stop(
        "The file extension used (`.", file_ext, "`) doesn't have an ",
        "associated saving function. ", ext_supported_text,
        call. = FALSE
      )
    }
  )
}

#' Saving function for an HTML file
#'
#' @noRd
gt_save_html <- function(data,
                         filename,
                         path = NULL,
                         ...,
                         inline_css = FALSE) {

  filename <- gtsave_filename(path = path, filename = filename)

  if (inline_css) {

    data %>%
      as_raw_html(inline_css = inline_css) %>%
      htmltools::HTML() %>%
      htmltools::save_html(filename, ...)

  } else {

    data %>%
      htmltools::as.tags() %>%
      htmltools::save_html(filename, ...)
  }
}

#' Saving function for an image file via the webshot package
#'
#' @noRd
gt_save_webshot <- function(data,
                            filename,
                            path = NULL,
                            ...,
                            zoom = 2,
                            expand = 5) {

  filename <- gtsave_filename(path = path, filename = filename)

  # Create a temporary file with the `html` extension
  tempfile_ <- tempfile(fileext = ".html")

  # Reverse slashes on Windows filesystems
  tempfile_ <-
    tempfile_ %>%
    tidy_gsub("\\\\", "/")

  # Save gt table as HTML using the `gt_save_html()` function
  gt_save_html(
    data = data,
    filename = tempfile_,
    path = NULL
  )

  # Saving an image requires the webshot package; if it's
  # not present, stop with a message
  if (!requireNamespace("webshot", quietly = TRUE)) {

    stop("The `webshot` package is required for saving images of gt tables.",
         call. = FALSE)

  } else {

    # Save the image in the working directory
    webshot::webshot(
      url = paste0("file:///", tempfile_),
      file = filename,
      selector = "table",
      zoom = zoom,
      expand = expand,
      ...
    )
  }
}

#' Saving function for a LaTeX file
#'
#' @noRd
gt_save_latex <- function(data,
                          filename,
                          path = NULL,
                          ...) {

  filename <- gtsave_filename(path = path, filename = filename)

  writeLines(text = as_latex(data = data), con = filename)
}

#' Saving function for an RTF file
#'
#' @noRd
gt_save_rtf <- function(data,
                        filename,
                        path = NULL,
                        ...,
                        page_numbering = c("none", "footer", "header")) {

  page_numbering <- match.arg(page_numbering)

  filename <- gtsave_filename(path = path, filename = filename)

  data %>%
    as_rtf(page_numbering = page_numbering) %>%
    writeLines(con = filename)
}

#' Get the lowercase extension from a filename
#'
#' @noRd
gtsave_file_ext <- function(filename) {

  tools::file_ext(filename) %>% tolower()
}

#' Combine `path` with `filename` and normalize the path
#'
#' @noRd
gtsave_filename <- function(path, filename) {

  if (is.null(path)) path <- "."

  # The use of `fs::path_abs()` works around
  # the saving code in `htmltools::save_html()`
  # See htmltools Issue #165 for more details

  fs::path_abs(
    path = filename,
    start = path
  ) %>%
    fs::path_expand() %>%
    as.character()
}

#' Get the HTML content of a **gt** table
#'
#' @description
#' Get the HTML content from a `gt_tbl` object as a single-element character
#' vector. By default, the generated HTML will have inlined styles, where CSS
#' styles (that were previously contained in CSS rule sets external to the
#' `<table> element`) are included as `style` attributes in the HTML table's
#' tags. This option is preferable when using the output HTML table in an
#' emailing context.
#'
#' @param data A table object that is created using the [gt()] function.
#' @param inline_css An option to supply styles to table elements as inlined CSS
#'   styles. This is useful when including the table HTML as part of an HTML
#'   email message body, since inlined styles are largely supported in email
#'   clients over using CSS in a `<style>` block.
#'
#' @examples
#' if (interactive()) {
#'
#' # Use `gtcars` to create a gt table;
#' # add a header and then export as
#' # HTML code with CSS inlined
#' tab_html <-
#'   gtcars %>%
#'   dplyr::select(mfr, model, msrp) %>%
#'   dplyr::slice(1:5) %>%
#'   gt() %>%
#'   tab_header(
#'     title = md("Data listing from **gtcars**"),
#'     subtitle = md("`gtcars` is an R dataset")
#'   ) %>%
#'   as_raw_html()
#'
#' # `tab_html` is a single-element vector
#' # containing inlined HTML for the table;
#' # it has only the `<table>...</table>` part
#' # so it's not a complete HTML document but
#' # rather an HTML fragment
#' tab_html %>%
#'   substr(1, 700) %>%
#'   cat()
#'
#' }
#'
#' @family Export Functions
#' @section Function ID:
#' 13-2
#'
#' @export
as_raw_html <- function(data,
                        inline_css = TRUE) {

  # Perform input object validation
  stop_if_not_gt(data = data)

  if (inline_css) {

    # Generation of the HTML table
    html_table <- render_as_html(data = data)

    # Create inline styles
    html_table <-
      inline_html_styles(
        html = html_table,
        css_tbl = get_css_tbl(data = data)
      )

  } else {
    html_table <- as.character(as.tags.gt_tbl(data))
  }

  htmltools::HTML(html_table)
}

#' Output a gt object as LaTeX
#'
#' @description
#' Get the LaTeX content from a `gt_tbl` object as a `knit_asis` object. This
#' object contains the LaTeX code and attributes that serve as LaTeX
#' dependencies (i.e., the LaTeX packages required for the table). Using
#' `as.character()` on the created object will result in a single-element vector
#' containing the LaTeX code.
#'
#' @param data A table object that is created using the [gt()] function.
#'
#' @examples
#' if (interactive()) {
#'
#' # Use `gtcars` to create a gt table;
#' # add a header and then export as
#' # an object with LaTeX code
#' tab_latex <-
#'   gtcars %>%
#'   dplyr::select(mfr, model, msrp) %>%
#'   dplyr::slice(1:5) %>%
#'   gt() %>%
#'   tab_header(
#'     title = md("Data listing from **gtcars**"),
#'     subtitle = md("`gtcars` is an R dataset")
#'   ) %>%
#'   as_latex()
#'
#' # `tab_latex` is a `knit_asis` object,
#' # which makes it easy to include in
#' # R Markdown documents that are knit to
#' # PDF; we can use `as.character()` to
#' # get just the LaTeX code as a single-
#' # element vector
#' tab_latex %>%
#'   as.character() %>%
#'   cat()
#'
#' }
#'
#' @family Export Functions
#' @section Function ID:
#' 13-3
#'
#' @export
as_latex <- function(data) {

  # Perform input object validation
  stop_if_not_gt(data = data)

  # Build all table data objects through a common pipeline
  data <- build_data(data = data, context = "latex")

  # Composition of LaTeX ----------------------------------------------------

  # Create a LaTeX fragment for the start of the table
  table_start <- create_table_start_l(data = data)

  # Create the heading component
  heading_component <- create_heading_component_l(data = data)

  # Create the columns component
  columns_component <- create_columns_component_l(data = data)

  # Create the body component
  body_component <- create_body_component_l(data = data)

  # Create the footnotes component
  footer_component <- create_footer_component_l(data = data)

  # Create a LaTeX fragment for the ending tabular statement
  table_end <- create_table_end_l()

  # If the `rmarkdown` package is available, use the
  # `latex_dependency()` function to load latex packages
  # without requiring the user to do so
  if (requireNamespace("rmarkdown", quietly = TRUE)) {
    latex_packages <- lapply(latex_packages(), rmarkdown::latex_dependency)
  } else {
    latex_packages <- NULL
  }

  # Compose the LaTeX table
  paste0(
    table_start,
    heading_component,
    columns_component,
    body_component,
    table_end,
    footer_component,
    collapse = ""
  ) %>%
    knitr::asis_output(meta = latex_packages)
}

#' Output a **gt** object as RTF
#'
#' @description
#' Get the RTF content from a `gt_tbl` object as as a single-element character
#' vector. This object can be used with `writeLines()` to generate a valid .rtf
#' file that can be opened by RTF readers.
#'
#' @param data A table object that is created using the `gt()` function.
#' @param page_numbering An option to include page numbering in the RTF
#'   document. The page numbering text can either be in the document `"footer"`
#'   or `"header"`. By default, page numbering is not active (`"none"`).
#'
#' @examples
#' if (interactive()) {
#'
#' # Use `gtcars` to create a gt table;
#' # add a header and then export as
#' # RTF code
#' tab_rtf <-
#'   gtcars %>%
#'   dplyr::select(mfr, model) %>%
#'   dplyr::slice(1:2) %>%
#'   gt() %>%
#'   tab_header(
#'     title = md("Data listing from **gtcars**"),
#'     subtitle = md("`gtcars` is an R dataset")
#'   ) %>%
#'   as_rtf()
#'
#' }
#'
#' @family Export Functions
#' @section Function ID:
#' 13-4
#'
#' @export
as_rtf <- function(data,
                   page_numbering = c("none", "footer", "header")) {

  page_numbering <- match.arg(page_numbering)

  # Perform input object validation
  stop_if_not_gt(data = data)

  # Build all table data objects through a common pipeline
  data <- build_data(data = data, context = "rtf")

  # Composition of RTF ------------------------------------------------------

  # Create the heading component
  heading_component <- create_heading_component_rtf(data = data)

  # Create the columns component
  columns_component <- create_columns_component_rtf(data = data)

  # Create the body component
  body_component <- create_body_component_rtf(data = data)

  # Create the footer component
  footer_component <- create_footer_component_rtf(data = data)

  # Compose the RTF table
  rtf_table <-
    as_rtf_string(
      rtf_file(
        document = {
          rtf_table(
            rows = c(
              heading_component,
              columns_component,
              body_component,
              footer_component
            )
          )
        },
        page_numbering = page_numbering
      )
    )

  if (isTRUE(getOption('knitr.in.progress'))) {
    rtf_table <- knitr::raw_output(rtf_table)
  }

  rtf_table
}


#' Extract a summary list from a **gt** object
#'
#' @description
#' Get a list of summary row data frames from a `gt_tbl` object where summary
#' rows were added via the [summary_rows()] function. The output data frames
#' contain the `group_id` and `rowname` columns, whereby `rowname` contains
#' descriptive stub labels for the summary rows.
#'
#' @param data A table object that is created using the [gt()] function.
#'
#' @return A list of data frames containing summary data.
#'
#' @examples
#' # Use `sp500` to create a gt table with
#' # row groups; create summary rows by row
#' # group (`min`, `max`, `avg`) and then
#' # extract the summary rows as a list
#' # object
#' summary_extracted <-
#'   sp500 %>%
#'   dplyr::filter(
#'     date >= "2015-01-05" &
#'       date <="2015-01-30"
#'   ) %>%
#'   dplyr::arrange(date) %>%
#'   dplyr::mutate(
#'     week = paste0(
#'       "W", strftime(date, format = "%V"))
#'   ) %>%
#'   dplyr::select(-adj_close, -volume) %>%
#'   gt(
#'     rowname_col = "date",
#'     groupname_col = "week"
#'   ) %>%
#'   summary_rows(
#'     groups = TRUE,
#'     columns = c(open, high, low, close),
#'     fns = list(
#'       min = ~min(.),
#'       max = ~max(.),
#'       avg = ~mean(.)),
#'     formatter = fmt_number,
#'     use_seps = FALSE
#'   ) %>%
#'   extract_summary()
#'
#' # Use the summary list to make a new
#' # gt table; the key thing is to use
#' # `dplyr::bind_rows()` and then pass the
#' # tibble to `gt()`
#' tab_1 <-
#'   summary_extracted %>%
#'   unlist(recursive = FALSE) %>%
#'   dplyr::bind_rows() %>%
#'   gt(groupname_col = "group_id")
#'
#' @section Figures:
#' \if{html}{\figure{man_extract_summary_1.png}{options: width=100\%}}
#'
#' @family Export Functions
#' @section Function ID:
#' 13-5
#'
#' @export
extract_summary <- function(data) {

  # Perform input object validation
  stop_if_not_gt(data = data)

  # Stop function if there are no
  # directives to create summary rows
  if (!dt_summary_exists(data = data)) {

    stop(
      "There is no summary list to extract.\n",
      "Use the `summary_rows()`/`grand_summary_rows()` functions to generate summaries.",
      call. = FALSE
    )
  }

  # Build the `data` using the standard
  # pipeline with the `html` context
  built_data <- build_data(data = data, context = "html")

  # Extract the list of summary data frames
  # that contains tidy, unformatted data
  summary_tbl <-
    dt_summary_df_data_get(data = built_data) %>%
    lapply(FUN = function(x) {
      lapply(x, function(y) {
        dplyr::rename(
          y,
          rowname = .env$rowname_col_private,
          group_id = .env$group_id_col_private
        )
      })
    })

  as.list(summary_tbl)
}
